home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / directories.mod (.txt) < prev    next >
Oberon Text  |  1996-06-03  |  14KB  |  399 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. ParcElems
  4. Alloc
  5. Syntax10b.Scn.Fnt
  6. Syntax8i.Scn.Fnt
  7. FoldElems
  8. MarkElems
  9. Alloc
  10. MODULE Directories;    (* CS 10.10.95 based on Windows-FileDir from MH Feb 93 / 2.6.94 and PowerMac-Directories from HM Oct 95 *)
  11. IMPORT
  12.     (*SYSTEM,*) TextFrames, O:=Console, Out, Files, AmigaDos, Strings; (*,Unix,directory*)
  13. CONST
  14.     noErr* = 0;    (**no error*)
  15.     badName* = 1;    (**bad file or directory name*)
  16.     mediumFull* = 2;    (**disk or directory full*)
  17.     mediumLocked* = 3;    (**hardware or software lock*)
  18.     dirInUse* = 4;    (**directory in use or not empty*)
  19.     notADir* = 5;    (**name does not specify a directory*)
  20.     alreadyExists* = 6;    (**directory already exists*)
  21.     otherError* = 7;    (**other OS-specific error*)
  22.     delete* = 0; insert* = 1;  change* = 2;     (** notify operations **)
  23.     delimiter* = "/";    (** delimiter in path names **)
  24.     Directory* = POINTER TO DirectoryDesc;
  25.     Entry* = POINTER TO EntryDesc;
  26.     DirectoryDesc* = RECORD
  27.         path*: ARRAY 256 OF CHAR;
  28.     END;
  29.     EntryDesc* = RECORD
  30.         dir*: Directory;
  31.         name*: ARRAY 32 OF CHAR;
  32.         hostname*: ARRAY 14 OF CHAR
  33.     END;
  34.     FileProc* = PROCEDURE (d: Directory; name: ARRAY OF CHAR; isDir: BOOLEAN; VAR continue: BOOLEAN);
  35.     PathProc* = PROCEDURE (path: ARRAY OF CHAR; VAR continue: BOOLEAN);
  36.     Notifier* = PROCEDURE (op: INTEGER; path, name: ARRAY OF CHAR);
  37.     FileInfoBlockPtr=POINTER TO AmigaDos.FileInfoBlock;
  38. (*    Directories = POINTER TO ARRAY OF Directory;*)
  39.     res*: INTEGER;
  40.     notify*: Notifier;
  41.     dirTab: POINTER TO ARRAY OF Directory;
  42.     startupPath: ARRAY 256 OF CHAR;    (*path containing the Oberon application*)
  43.     nofPaths: INTEGER;
  44.     CurrentDir: Directory;
  45. PROCEDURE 
  46. AppendFile (VAR path: ARRAY OF CHAR; filename: ARRAY OF CHAR);
  47.     VAR i, j, max: LONGINT;
  48. BEGIN
  49.     i := 0; j := 0; max := LEN(path)-1;
  50.     WHILE path[i] # 0X DO INC(i) END ;
  51.     IF (i > 0) & (path[i-1] # delimiter) THEN path[i] := delimiter; INC(i) END ;
  52.     WHILE (i < max) & (filename[j] # 0X) DO path[i] := filename[j]; INC(i); INC(j) END ;
  53.     path[i] := 0X;
  54. END AppendFile;
  55. PROCEDURE 
  56. InsertEntry* (D: Directory; e: Entry);
  57. BEGIN
  58.     (* No meaning under Unix. *)
  59. END InsertEntry;
  60. PROCEDURE 
  61. RemoveEntry* (e: Entry);
  62. BEGIN
  63.     (* No meaning under Unix. *)
  64. END RemoveEntry;
  65. PROCEDURE 
  66. ThisEntry* (D: Directory; VAR name: ARRAY OF CHAR): Entry;
  67. BEGIN
  68.     RETURN NIL;
  69. END ThisEntry;
  70. PROCEDURE 
  71. ThisHostEntry* (D: Directory; VAR hostname: ARRAY OF CHAR): Entry;
  72. BEGIN
  73.     RETURN NIL;
  74. END ThisHostEntry;
  75. PROCEDURE 
  76. ExpandPath (this: ARRAY OF CHAR; VAR absPath: ARRAY OF CHAR);
  77.     current:ARRAY 256 OF CHAR;
  78.     pwd:ARRAY 256 OF CHAR;
  79.     fib : FileInfoBlockPtr;
  80.     lock: AmigaDos.FileLockPtr;
  81. BEGIN
  82.     IF AmigaDos.GetCurrentDirName(current, LEN(current)) THEN
  83.         COPY(this, absPath);
  84.         IF AmigaDos.SetCurrentDirName(absPath) THEN
  85.             IF AmigaDos.GetCurrentDirName(pwd, LEN(pwd)) THEN 
  86.                 COPY(pwd, absPath); 
  87.                 (* Now we have to check wether this really is a directory. SetCurrentDir() even works with Files!  <<FF *)
  88.                 lock := AmigaDos.Lock(absPath, AmigaDos.sharedLock);
  89.                 IF lock#0 THEN
  90.                     NEW(fib);
  91.                     IF AmigaDos.NameFromLock(lock, absPath) THEN END;
  92.                     IF AmigaDos.Examine(lock, fib^) THEN
  93.                         IF fib.dirEntryType<0 THEN 
  94.                             absPath[0] := 0X; 
  95.                         END;
  96.                     END;
  97.                     AmigaDos.UnLock(lock);
  98.                     fib := NIL;
  99.                 ELSE
  100.                     absPath[0] := 0X; (* couldn't lock dir/file *)
  101.                 END;
  102.             ELSE
  103.                 absPath[0] := 0X;
  104.             END;
  105.             IF AmigaDos.SetCurrentDirName(current) THEN END;
  106.         ELSE
  107.             absPath[0] := 0X;
  108.         END;
  109.     ELSE
  110.         absPath[0] := 0X;                
  111.     END;
  112. END ExpandPath;
  113. PROCEDURE 
  114. OpenDirectory (VAR absPath: ARRAY OF CHAR; VAR D: Directory);
  115. BEGIN
  116.     ExpandPath(absPath,absPath);
  117.     IF absPath="" THEN
  118.         D:=NIL;
  119.     ELSE
  120.         NEW(D);
  121.         COPY(absPath,D.path);
  122.     END;
  123. END OpenDirectory;
  124. PROCEDURE 
  125. Map* (name: ARRAY OF CHAR; VAR hostname: ARRAY OF CHAR);
  126. BEGIN
  127.     COPY(name,hostname);
  128. END Map;
  129. PROCEDURE 
  130. NextMapping* (VAR name: ARRAY OF CHAR);
  131. BEGIN
  132.     (* No meaning under Unix. *)
  133. END NextMapping;
  134. PROCEDURE 
  135. Exists* (dir: Directory; VAR hostname: ARRAY OF CHAR): BOOLEAN;
  136.     done:BOOLEAN;
  137.     fullname:ARRAY 256 OF CHAR;
  138.     lock: AmigaDos.FileLockPtr;
  139. BEGIN
  140.     COPY(dir.path,fullname);
  141.     AppendFile(fullname,hostname);
  142.     lock := AmigaDos.Lock(fullname, AmigaDos.sharedLock);
  143.     IF lock#0 THEN
  144.         AmigaDos.UnLock(lock);
  145.         RETURN TRUE;
  146.     END;
  147.     RETURN FALSE;
  148. END Exists;
  149. PROCEDURE 
  150. This*(path: ARRAY OF CHAR):Directory;
  151.     D:Directory; 
  152.     absPath:ARRAY 256 OF CHAR;
  153. BEGIN
  154.     ExpandPath(path,absPath);
  155.     IF absPath="" THEN RETURN NIL END ;
  156.     OpenDirectory(absPath,D);
  157.     RETURN D;
  158. END This;
  159. PROCEDURE 
  160. RenameEntry* (e: Entry; VAR new: ARRAY OF CHAR);
  161.     name1, name2: ARRAY 256 OF CHAR;
  162. BEGIN
  163.     COPY(e.dir.path, name1);
  164.     AppendFile(name1, e.name);
  165.     COPY(e.dir.path, name2);
  166.     AppendFile(name2, new);
  167.     IF AmigaDos.Rename(name1, name2) THEN END;
  168.     (* Files.Rename ! *)
  169.     oldName,newName:ARRAY 32 OF CHAR;
  170. BEGIN
  171.     COPY(e.dir.path, oldName);
  172.     COPY(e.dir.path, newName);
  173.     AppendFile(oldName, e.name);
  174.     AppendFile(newName, new);
  175.     res := otherError;
  176.     Files.Rename(oldName, newName, res);
  177.     IF res = 0 THEN
  178.         notify(delete, e.dir.path, e.name);
  179.         COPY(new, e.name);
  180.         notify(insert, e.dir.path, e.name);
  181.         res := noErr;
  182.     ELSE
  183.         res := otherError;
  184.     END;    
  185.     res:=otherError;
  186. END RenameEntry;
  187. PROCEDURE 
  188. DeleteFile* (dir: Directory; VAR name: ARRAY OF CHAR);
  189.     fullname: ARRAY 256 OF CHAR;
  190. BEGIN
  191.     COPY(dir.path,fullname); AppendFile(fullname,name);
  192.     Files.Delete(fullname,res);
  193. END DeleteFile;
  194. PROCEDURE 
  195. GetHostname* (name: ARRAY OF CHAR; VAR hostname: ARRAY OF CHAR);
  196. BEGIN
  197.     COPY(name, hostname);
  198. END GetHostname;
  199. PROCEDURE 
  200. Enumerate* (D: Directory; H: FileProc);
  201.     fib: FileInfoBlockPtr;
  202.     lock: AmigaDos.FileLockPtr;
  203.     continue: BOOLEAN;
  204.     PROCEDURE CheckDigit(ch: CHAR): BOOLEAN;
  205.     BEGIN    RETURN (ch=".") OR ((ch>="0") & (ch<="9"));
  206.     END CheckDigit;
  207.     PROCEDURE CheckChar(ch: CHAR): BOOLEAN;
  208.     BEGIN    RETURN CheckDigit(ch) OR ((ch>="A") & (ch<="Z")) OR ((ch>="a") & (ch<="z"));
  209.     END CheckChar;
  210.     PROCEDURE CheckName(name: ARRAY OF CHAR): BOOLEAN;
  211.         i: INTEGER;
  212.     BEGIN
  213.         IF CheckDigit(name[0]) THEN RETURN TRUE END;
  214.         WHILE name[i]#0X DO
  215.             IF ~CheckChar(name[i]) THEN RETURN TRUE END;
  216.             INC(i);
  217.         END;
  218.         RETURN FALSE; 
  219.     END CheckName;
  220. BEGIN
  221.     lock := AmigaDos.Lock(D.path,AmigaDos.sharedLock);
  222.     IF lock#0 THEN
  223.         NEW(fib);
  224.         IF AmigaDos.Examine(lock, fib^) THEN
  225.             continue := TRUE;
  226.             LOOP
  227.                 IF AmigaDos.ExNext(lock,fib^) THEN
  228.                     (* Check wether there are illegal characters in the filename <<FF *)
  229.                     IF ~CheckName(fib.fileName) THEN H(D, fib.fileName, fib.dirEntryType>0, continue) END;
  230.                     IF ~continue THEN EXIT END;
  231.                 ELSE
  232.                     IF AmigaDos.IoErr()=232 THEN EXIT END;  (* Check for NO_MORE_ENTRIES *)
  233.                 END;        
  234.             END;
  235.         END;
  236.         AmigaDos.UnLock(lock);
  237.         fib := NIL;
  238.     END;    
  239. END Enumerate;
  240. PROCEDURE 
  241. Current*():Directory;
  242.     current:ARRAY 256 OF CHAR;
  243. BEGIN
  244.     IF CurrentDir=NIL THEN
  245.         IF AmigaDos.GetCurrentDirName(current, LEN(current)) THEN END;
  246.         CurrentDir:=This(current);
  247.     END;
  248.     RETURN CurrentDir;
  249. END Current;
  250. PROCEDURE 
  251. Change*(path:ARRAY OF CHAR);
  252.     D:Directory;
  253.     rc:LONGINT;
  254.     res: INTEGER;
  255.     buf: ARRAY 256 OF CHAR;
  256. BEGIN
  257.     D:=This(path);
  258.     IF D#NIL THEN
  259.         Files.ChangeDirectory(path, res);
  260.         IF res=0 THEN
  261.         (*IF AmigaDos.SetCurrentDirName(path) THEN*)
  262.             res:=noErr;
  263.             CurrentDir:=D;
  264.             notify(change,"","");
  265.             RETURN;
  266.         END;
  267.     END;
  268.      (* Try to change relative to startup path *)     (*<<FF 29.6.96*)
  269.     COPY(startupPath, buf);
  270.     AppendFile(buf, path);
  271.     D := This(buf);
  272.     Files.ChangeDirectory(buf, res);
  273.     IF res=0 THEN
  274.         res := noErr;
  275.         CurrentDir := D;
  276.         notify(change,"","");
  277.     ELSE
  278.         res := otherError;
  279.     END;                
  280. END Change;
  281. PROCEDURE 
  282.  Startup* (): Directory;
  283. BEGIN
  284.     RETURN This(startupPath)
  285. END Startup;
  286. PROCEDURE 
  287. Split (path: ARRAY OF CHAR; VAR path0, dirName: ARRAY OF CHAR);
  288.     VAR i, j: INTEGER;
  289. BEGIN
  290.     i := 0; j := 0;
  291.     WHILE path[i] # 0X DO
  292.         path0[i] := path[i];
  293.         IF path[i] = delimiter THEN j := i END ;
  294.         INC(i)
  295.     END ;
  296.     path0[j] := 0X; INC(j); i := 0;
  297.     WHILE path[j] # 0X DO
  298.         dirName[i] := path[j];
  299.         INC(i); INC(j)
  300.     END ;
  301.     dirName[i] := 0X
  302. END Split;
  303. PROCEDURE 
  304. Create* (path: ARRAY OF CHAR);
  305.     absPath: ARRAY 256 OF CHAR;
  306.     dirName: ARRAY 32 OF CHAR;
  307.     lock: AmigaDos.FileLockPtr;
  308.     done:BOOLEAN;
  309. BEGIN
  310.     COPY(path,absPath);
  311.     lock :=  AmigaDos.CreateDir(absPath);
  312.     IF lock#0 THEN
  313.         AmigaDos.UnLock(lock);
  314.         ExpandPath(absPath,absPath);
  315.         Split(absPath, path,dirName);
  316.         notify(insert,path,dirName);
  317.         res:=noErr;
  318.     ELSE
  319.         res:=otherError;
  320. END Create;
  321. PROCEDURE 
  322. Delete* (path: ARRAY OF CHAR);
  323.     VAR absPath: ARRAY 256 OF CHAR; dirName: ARRAY 32 OF CHAR;
  324. BEGIN
  325.     ExpandPath(path,absPath);
  326.     Files.Delete(absPath,res);
  327.     IF res=0 THEN
  328.         Split(absPath,path,dirName);
  329.         notify(delete,path,dirName);
  330.         res:=noErr;
  331.     ELSE
  332.         res:=otherError;
  333. END Delete;
  334. PROCEDURE 
  335. Rename* (oldPath, newPath: ARRAY OF CHAR);
  336.     oldPath0,newPath0:ARRAY 256 OF CHAR;
  337.     oldName,newName:ARRAY 32 OF CHAR;
  338. BEGIN
  339.     res:=otherError;
  340.     ExpandPath(oldPath,oldPath0);
  341.     IF oldPath0[0]#0X THEN
  342.         COPY(newPath,newPath0);
  343.         Files.Rename(oldPath0,newPath0,res);
  344.         IF res=0 THEN
  345.             Split(oldPath0,oldPath,oldName);
  346.             notify(delete,oldPath,oldName);
  347.             ExpandPath(newPath0,newPath0);
  348.             Split(newPath0,newPath,newName);
  349.             notify(insert,newPath,newName);
  350.             res:=noErr;
  351.         ELSE
  352.             res:=otherError;
  353.         END
  354. END Rename;
  355. PROCEDURE 
  356. EnumeratePaths* (proc: PathProc);
  357.     VAR pathNo: LONGINT; continue: BOOLEAN; dir: Directory;
  358. BEGIN
  359.     pathNo := 0; continue := TRUE;
  360.     WHILE continue & (pathNo < nofPaths) DO
  361.         dir:=dirTab[pathNo];
  362.         proc(dir.path, continue);
  363.         INC(pathNo)
  364. END EnumeratePaths;
  365. PROCEDURE 
  366. InitDirectories;
  367.     dirCnt: INTEGER;
  368.     buf: ARRAY 256 OF CHAR;
  369.     file: AmigaDos.FileLockPtr;
  370. BEGIN
  371.     file := AmigaDos.Open("Paths", AmigaDos.oldFile);    (* Open configuration file *)
  372.     IF file#0 THEN
  373.         WHILE AmigaDos.FGets(file, buf, LEN(buf))#0 DO                        (* Read the number of Paths *)
  374.             IF buf[0]#";" THEN INC(nofPaths) END;                                    (* ignore comment lines *)
  375.         END;
  376.         NEW(dirTab, nofPaths);                                                            (* allocate path table *)
  377.         IF AmigaDos.Seek(file, 0, AmigaDos.beginning)#0 THEN END;        (* Move to beginning of file *)
  378.         WHILE AmigaDos.FGets(file, buf, LEN(buf))#0 DO                        (* Read in the path lines *)
  379.             IF buf[0]#";" THEN 
  380.                 NEW(dirTab[dirCnt]);
  381.                 COPY(buf, dirTab[dirCnt].path);
  382.                 INC(dirCnt);
  383.             END;
  384.         END;
  385.         IF AmigaDos.Close(file) THEN END;
  386.     ELSE
  387.         O.Str("Directories.InitDirectories: Cannot find `paths'!"); O.Ln;
  388.     END;
  389.     startupPath := "Oberon4Amiga:";
  390.     CurrentDir:=This(startupPath);
  391. END InitDirectories;
  392. PROCEDURE 
  393. NoNotify (op: INTEGER; path, name: ARRAY OF CHAR);
  394. END NoNotify;
  395. BEGIN
  396.     notify := NoNotify;
  397.     InitDirectories
  398. END Directories.
  399.